The Arsenal Files 4/The Arsenal Files 4 (Arsenal Computer).ISO/clarion/disabl.exe/CONTA004.CLW

Text File | 1995-01-05 | 25KB | 716 lines

                     MEMBER('CONTACTS.clw')       ! This is a MEMBER module
BrowseByCompany PROCEDURE

LocalRequest         LONG,AUTO
OriginalRequest      LONG,AUTO
LocalResponse        LONG,AUTO
WindowOpened         LONG
WindowInitialized    LONG
ForceRefresh         LONG,AUTO
RecordFiltered       LONG
Queue:Browse         QUEUE                        ! Browsing Queue
Brw1::CON:Company      LIKE(CON:Company)          ! Queue Display field
Brw1::CON:FirstName    LIKE(CON:FirstName)        ! Queue Display field
Brw1::CON:LastName     LIKE(CON:LastName)         ! Queue Display field
Brw1::CON:Address1     LIKE(CON:Address1)         ! Queue Display field
Brw1::CON:Address2     LIKE(CON:Address2)         ! Queue Display field
Brw1::CON:City         LIKE(CON:City)             ! Queue Display field
Brw1::CON:State        LIKE(CON:State)            ! Queue Display field
Brw1::CON:Zip          LIKE(CON:Zip)              ! Queue Display field
Brw1::CON:Phone        LIKE(CON:Phone)            ! Queue Display field
Brw1::CON:Fax          LIKE(CON:Fax)              ! Queue Display field
Brw1::CON:JobTitle     LIKE(CON:JobTitle)         ! Queue Display field
Brw1::CON:Interest     LIKE(CON:Interest)         ! Queue Display field
Brw1::CON:TimeFrame    LIKE(CON:TimeFrame)        ! Queue Display field
Brw1::CON:CurrentSoftware LIKE(CON:CurrentSoftware) ! Queue Display field
Brw1::CON:Remarks      LIKE(CON:Remarks)          ! Queue Display field
Brw1::Position         STRING(255)                ! Queue POSITION information
                     END                          ! END (Browsing Queue)
Brw1::RecordStatus   BYTE                         ! Flag for Range/Filter test
Brw1::ItemsToFill    LONG                         ! Controls records retrieved
Brw1::MaxItemsInList LONG                         ! Retrieved after window opened
Brw1::LocatedPosition STRING(255)                 ! POSITION of located record
Brw1::QueuePointer   LONG                         ! Queue position of located record
Brw1::NextChoice     LONG                         ! Queue position of located record
Brw1::CurrentScroll  BYTE                         ! Queue position of scroll thumb
BrowseCoWindow       WINDOW('Browse by Company'),AT(24,26,247,129),FONT('Arial',10,,),SYSTEM,GRAY,MDI
                       LIST,AT(5,5,235,100),MSG('Browsing Records'),USE(?List),IMM,HVSCROLL,FORMAT('80L~Company~@s25@80L~First Name~@s20@80L~Last Name~@s20@80L~Address 1~@s25@80L~A' &|
   'ddress 2~@s25@80L~City~@s25@80L~State~@s2@80L~Zip~@s5@80L~Phone~@p(###) ###-####' &|
   'p@80L~Fax~@p(###) ###-####p@80L~Job Title~@s25@80L~Interest~@s45@80L~Time Frame~' &|
   '@s15@80L~Current Software~@s25@80L~Remarks~@s45@'),FROM(Queue:Browse)
                       BUTTON('&Insert'),AT(5,110,45,12),USE(?Insert)
                       BUTTON('&Change'),AT(50,110,45,12),USE(?Change),DEFAULT
                       BUTTON('&Delete'),AT(95,110,45,12),USE(?Delete)
                       BUTTON('&Select'),AT(145,110,40,12),USE(?Select)
                       BUTTON('Close'),AT(200,110,40,12),USE(?Close)
                     END
  CODE
  LocalRequest = GlobalRequest
  OriginalRequest = GlobalRequest
  LocalResponse = RequestCancelled
  CLEAR(GlobalRequest)
  CLEAR(GlobalResponse)
  IF contacts::Used = 0
    CheckOpen(contacts,1)
  END
  contacts::Used += 1
  OPEN(BrowseCoWindow)
  WindowOpened=True
  !sets Global
  BrowseByCompanyRef1 &= BrowseCoWindow
  SET(CON:Key_Company)
  ?List{Prop:Alrt,251} = MouseLeft2
  IF LocalRequest = SelectRecord
    ENABLE(?Select)
    ?Select{Prop:Default} = True
  ELSE
    DISABLE(?Select)
  END
  ?List{Prop:Alrt,255} = InsertKey
  ?List{Prop:Alrt,254} = DeleteKey
  ?List{Prop:Alrt,253} = CtrlEnter
  ACCEPT
    CASE EVENT()
    OF EVENT:CloseWindow
      !Tells Global that window is closed
      BrowseByCompanyOpen=0
      DO RefreshWindow
    OF EVENT:OpenWindow
      IF NOT WindowInitialized
        DO InitializeWindow
      END
      SELECT(?List)
    OF EVENT:GainFocus
      WindowInitialized = True
      DO InitializeWindow
    ELSE
      CASE EVENT()
      OF EVENT:Restore
          IF BrowseByCompanyRef1{PROP:Iconize} = TRUE
              BrowseByCompanyRef1{PROP:Iconize} = FALSE
          END
          BrowseByCompanyRef1{PROP:Active} = TRUE
          POST(EVENT:Resume)
      END
    END
    CASE FIELD()
    OF ?List
      CASE EVENT()
      OF EVENT:Accepted
        DO Brw1::FillBuffer
        DO RefreshWindow
      OF EVENT:NewSelection
        DO Brw1::FillBuffer
        DO RefreshWindow
      OF EVENT:ScrollUp
        DO Brw1::ScrollUp
        DO RefreshWindow
      OF EVENT:ScrollDown
        DO Brw1::ScrollDown
        DO RefreshWindow
      OF EVENT:PageUp
        DO Brw1::PageUp
        DO RefreshWindow
      OF EVENT:PageDown
        DO Brw1::PageDown
        DO RefreshWindow
      OF EVENT:ScrollTop
        DO Brw1::ScrollTop
        DO RefreshWindow
      OF EVENT:ScrollBottom
        DO Brw1::ScrollBottom
        DO RefreshWindow
      OF EVENT:AlertKey
        DO Brw1::AlertKey
        DO RefreshWindow
      END
    OF ?Insert
      CASE EVENT()
      OF EVENT:Accepted
        DO SyncWindow
        DO Brw1::ButtonInsert
        DO RefreshWindow
      END
    OF ?Change
      CASE EVENT()
      OF EVENT:Accepted
        DO SyncWindow
        DO Brw1::ButtonChange
        DO RefreshWindow
      END
    OF ?Delete
      CASE EVENT()
      OF EVENT:Accepted
        DO SyncWindow
        DO Brw1::ButtonDelete
        DO RefreshWindow
      END
    OF ?Select
      CASE EVENT()
      OF EVENT:Accepted
        DO SyncWindow
        LocalResponse = RequestCompleted
        POST(Event:CloseWindow)
        CYCLE
        DO RefreshWindow
      END
    OF ?Close
      CASE EVENT()
      OF EVENT:Accepted
        DO SyncWindow
        LocalResponse = RequestCancelled
        POST(Event:CloseWindow)
        DO RefreshWindow
      END
    END
  END
  contacts::Used -= 1
  IF contacts::Used = 0 THEN CLOSE(contacts).
  IF WindowOpened
    CLOSE(BrowseCoWindow)
  END
  IF LocalResponse
    GlobalResponse = LocalResponse
  ELSE
    GlobalResponse = RequestCancelled
  END
  RETURN
!---------------------------------------------------------------------------
InitializeWindow ROUTINE
  DO Brw1::OpenWindow
  ForceRefresh = True
  DO RefreshWindow
!---------------------------------------------------------------------------
RefreshWindow ROUTINE
  IF ForceRefresh
    GET(Queue:Browse,CHOICE(?List))
    REGET(CON:Key_Company,Brw1::Position)
    DO Brw1::ValidateRecord
    IF Brw1::RecordStatus <> Record:OK
      FREE(Queue:Browse)
      SET(CON:Key_Company)
      DO Brw1::RefreshPage
    ELSE
      DO Brw1::LocateRecord
    END
  ELSE
    DO Brw1::ValidateRecord
    IF Brw1::RecordStatus <> Record:OK
      FREE(Queue:Browse)
      SET(CON:Key_Company)
      DO Brw1::RefreshPage
    END
  END
  ?List{Prop:VScrollPos} = Brw1::CurrentScroll
  DISPLAY()
  ForceRefresh = False
!---------------------------------------------------------------------------
SyncWindow ROUTINE
  IF RECORDS(Queue:Browse)
    GET(Queue:Browse,CHOICE(?List))
    REGET(CON:Key_Company,Brw1::Position)
  END
!---------------------------------------------------------------------------
Brw1::OpenWindow ROUTINE
  IF LocalRequest = SelectRecord
    SET(CON:Key_Company,CON:Key_Company)
    DO Brw1::LocateRecord
  ELSE
    SET(CON:Key_Company)
    DO Brw1::RefreshPage
    SELECT(?List,1)
  END
  DO Brw1::FillBuffer
!----------------------------------------------------------------------
Brw1::FillBuffer ROUTINE
  GET(Queue:Browse,CHOICE(?List))
  CON:Company = Brw1::CON:Company
  CON:FirstName = Brw1::CON:FirstName
  CON:LastName = Brw1::CON:LastName
  CON:Address1 = Brw1::CON:Address1
  CON:Address2 = Brw1::CON:Address2
  CON:City = Brw1::CON:City
  CON:State = Brw1::CON:State
  CON:Zip = Brw1::CON:Zip
  CON:Phone = Brw1::CON:Phone
  CON:Fax = Brw1::CON:Fax
  CON:JobTitle = Brw1::CON:JobTitle
  CON:Interest = Brw1::CON:Interest
  CON:TimeFrame = Brw1::CON:TimeFrame
  CON:CurrentSoftware = Brw1::CON:CurrentSoftware
  CON:Remarks = Brw1::CON:Remarks
!----------------------------------------------------------------------
Brw1::FillQueue ROUTINE
  Brw1::CON:Company = CON:Company
  Brw1::CON:FirstName = CON:FirstName
  Brw1::CON:LastName = CON:LastName
  Brw1::CON:Address1 = CON:Address1
  Brw1::CON:Address2 = CON:Address2
  Brw1::CON:City = CON:City
  Brw1::CON:State = CON:State
  Brw1::CON:Zip = CON:Zip
  Brw1::CON:Phone = CON:Phone
  Brw1::CON:Fax = CON:Fax
  Brw1::CON:JobTitle = CON:JobTitle
  Brw1::CON:Interest = CON:Interest
  Brw1::CON:TimeFrame = CON:TimeFrame
  Brw1::CON:CurrentSoftware = CON:CurrentSoftware
  Brw1::CON:Remarks = CON:Remarks
  Brw1::Position = POSITION(CON:Key_Company)
!----------------------------------------------------------------------
Brw1::ScrollUp ROUTINE
  IF CHOICE(?List)>1
    SELECT(?List, CHOICE(?List)-1)
    POST(Event:NewSelection,?List)
  ELSE
    GET(Queue:Browse,1)                           ! Get the first queue item
    RESET(CON:Key_Company,Brw1::Position)         ! Reset for sequential processing
    NOMEMO(contacts)
    PREVIOUS(contacts)                            ! Retrieve record, reverse access
    Brw1::ItemsToFill = 1                         ! Load a single item
    DO Brw1::FillBackward                         ! Fill with previous read(s)
    IF Brw1::ItemsToFill                          ! If Load failed
      Brw1::CurrentScroll = 0                     ! Move Thumb to top
    ELSE
      Brw1::CurrentScroll = 50                    ! Move Thumb to center
    END
  END
!----------------------------------------------------------------------
Brw1::ScrollDown ROUTINE
  IF CHOICE(?List)<RECORDS(Queue:Browse)
    SELECT(?List, CHOICE(?List)+1)
    POST(Event:NewSelection,?List)
  ELSE
    GET(Queue:Browse,RECORDS(Queue:Browse))       ! Get the last queue item
    RESET(CON:Key_Company,Brw1::Position)         ! Reset for sequential processing
    NOMEMO(contacts)
    NEXT(contacts)                                ! Retrieve record, forward access
    Brw1::ItemsToFill = 1                         ! load a single item
    DO Brw1::FillForward                          ! Fill with next read(s)
    IF Brw1::ItemsToFill                          ! If Load failed
      Brw1::CurrentScroll = 100                   ! Move Thumb to top
    ELSE
      Brw1::CurrentScroll = 50                    ! Move Thumb to center
    END
  END
!----------------------------------------------------------------------
Brw1::PageUp ROUTINE
  GET(Queue:Browse,1)                             ! Get the first queue item
  RESET(CON:Key_Company,Brw1::Position)           ! Reset for sequential processing
  NOMEMO(contacts)
  PREVIOUS(contacts)                              ! Retrieve record, reverse access
  Brw1::ItemsToFill = ?List{Prop:Items}           ! Load a full page
  DO Brw1::FillBackward                           ! Fill with previous read(s)
  IF Brw1::ItemsToFill
    Brw1::NextChoice = CHOICE(?List)-Brw1::ItemsToFill
    IF Brw1::NextChoice < 1
      Brw1::NextChoice = 1
    END
    SELECT(?List, Brw1::NextChoice)
    Brw1::CurrentScroll = 0                       ! Move Thumb to top
  ELSE
    Brw1::CurrentScroll = 50                      ! Move Thumb to center
  END
!----------------------------------------------------------------------
Brw1::PageDown ROUTINE
  GET(Queue:Browse,RECORDS(Queue:Browse))         ! Get the last queue item
  RESET(CON:Key_Company,Brw1::Position)           ! Reset for sequential processing
  NOMEMO(contacts)
  NEXT(contacts)                                  ! Retrieve record, forward access
  Brw1::ItemsToFill = ?List{Prop:Items}           ! Load a full page
  DO Brw1::FillForward                            ! Fill with next read(s)
  IF Brw1::ItemsToFill
    Brw1::NextChoice = CHOICE(?List)+Brw1::ItemsToFill
    IF Brw1::NextChoice > RECORDS(Queue:Browse)
      Brw1::NextChoice = RECORDS(Queue:Browse)
    END
    SELECT(?List, Brw1::NextChoice)
    Brw1::CurrentScroll = 100                     ! Move Thumb to top
  ELSE
    Brw1::CurrentScroll = 50                      ! Move Thumb to center
  END
!----------------------------------------------------------------------
Brw1::ScrollTop ROUTINE
  FREE(Queue:Browse)                              ! Free the browse queue
  SET(CON:Key_Company)
  DO Brw1::RefreshPage
  SELECT(?List,1)                                 ! Select first list item
  Brw1::CurrentScroll = 0
!----------------------------------------------------------------------
Brw1::ScrollBottom ROUTINE
  SETCURSOR(Cursor:Wait)
  FREE(Queue:Browse)                              ! Free the browse queue
  SET(CON:Key_Company)
  Brw1::ItemsToFill = ?List{Prop:Items}           ! Load a full page
  DO Brw1::FillBackward                           ! Fill with previous read(s)
  SELECT(?List, RECORDS(Queue:Browse))            ! Select last list item
  IF RECORDS(Queue:Browse) = ?List{Prop:Items}
    Brw1::CurrentScroll = 100
  ELSE
    Brw1::CurrentScroll = 0
  END
  SETCURSOR()
!----------------------------------------------------------------------
Brw1::AlertKey ROUTINE
  CASE KEYCODE()                                  ! What keycode was hit
  OF MouseLeft2
    IF LocalRequest = SelectRecord
      POST(Event:Accepted,?Select)
      EXIT
    END
    POST(Event:Accepted,?Change)
    EXIT
  OF InsertKey
    POST(Event:Accepted,?Insert)
  OF DeleteKey
    POST(Event:Accepted,?Delete)
  OF CtrlEnter
    POST(Event:Accepted,?Change)
  ELSE                                            ! ELSE (What keycode was hit)
    IF CHR(KEYCHAR())
      SET(CON:Key_Company)
      CON:Company = CHR(KEYCHAR())
      DO Brw1::LocateRecord                       ! Find the record
    END
  END                                             ! END (What keycode was hit)
!----------------------------------------------------------------------
Brw1::ValidateRecord ROUTINE
  Brw1::RecordStatus = Record:OutOfRange
  IF ERRORCODE() THEN EXIT.
  Brw1::RecordStatus = Record:OK
  EXIT
!----------------------------------------------------------------------
Brw1::FillForward ROUTINE
  LOOP WHILE Brw1::ItemsToFill
    NEXT(contacts)
    DO Brw1::ValidateRecord
    EXECUTE(Brw1::RecordStatus)
      BEGIN
        SET(CON:Key_Company)
        BREAK
      END
      CYCLE
    END
    IF RECORDS(Queue:Browse) = ?List{Prop:Items}
      GET(Queue:Browse,1)
      DELETE(Queue:Browse)
    END
    Brw1::ItemsToFill -= 1
    DO Brw1::FillQueue
    ADD(Queue:Browse)
  END
  EXIT
!----------------------------------------------------------------------
Brw1::FillBackward ROUTINE
  LOOP WHILE Brw1::ItemsToFill
    PREVIOUS(contacts)
    DO Brw1::ValidateRecord
    EXECUTE(Brw1::RecordStatus)
      BEGIN
        SET(CON:Key_Company)
        BREAK
      END
      CYCLE
    END
    IF RECORDS(Queue:Browse) = ?List{Prop:Items}
      GET(Queue:Browse,RECORDS(Queue:Browse))
      DELETE(Queue:Browse)
    END
    Brw1::ItemsToFill -= 1
    DO Brw1::FillQueue
    ADD(Queue:Browse,1)
  END
  EXIT
!----------------------------------------------------------------------
Brw1::LocateRecord ROUTINE
  SETCURSOR(Cursor:Wait)
  FREE(Queue:Browse)
  SET(CON:Key_Company,CON:Key_Company)
  Brw1::LocatedPosition = ''
  LOOP
    NEXT(contacts)
    DO Brw1::ValidateRecord
    EXECUTE(Brw1::RecordStatus)
      BREAK
      CYCLE
    END
    Brw1::LocatedPosition = POSITION(CON:Key_Company)
    RESET(CON:Key_Company,Brw1::LocatedPosition)
    BREAK
  END
  Brw1::ItemsToFill = ?List{Prop:Items}
  Brw1::CurrentScroll = 50
  DO Brw1::FillForward
  IF Brw1::ItemsToFill
    Brw1::CurrentScroll = 100
    IF ~RECORDS(Queue:Browse)
      SET(CON:Key_Company)
    ELSE
      GET(Queue:Browse,1)
      RESET(CON:Key_Company,Brw1::Position)
      PREVIOUS(contacts)
    END
    DO Brw1::FillBackward
    IF Brw1::ItemsToFill
      Brw1::CurrentScroll = 0
    END
  END
  IF ~RECORDS(Queue:Browse)
    CLEAR(CON:Record)
    CLEAR(CON:Remarks)
    SET(CON:Key_Company)
    ?Change{Prop:Disable} = 1
    ?Delete{Prop:Disable} = 1
  ELSE
    IF Brw1::LocatedPosition
      Brw1::QueuePointer = 1
      LOOP
        GET(Queue:Browse,Brw1::QueuePointer)
        IF ERRORCODE() THEN BREAK.
        IF Brw1::Position = Brw1::LocatedPosition THEN BREAK.
        Brw1::QueuePointer += 1
      END
    ELSE
      Brw1::QueuePointer = RECORDS(Queue:Browse)
    END
    SELECT(?List,Brw1::QueuePointer)
    DO Brw1::FillBuffer
    REGET(CON:Key_Company,Brw1::Position)
    ?Change{Prop:Disable} = 0
    ?Delete{Prop:Disable} = 0
  END
  SETCURSOR()
!----------------------------------------------------------------------
Brw1::RefreshPage ROUTINE
  SETCURSOR(Cursor:Wait)
  IF RECORDS(Queue:Browse)
    GET(Queue:Browse,1)
    RESET(CON:Key_Company,Brw1::Position)
    FREE(Queue:Browse)
  END
  Brw1::ItemsToFill = ?List{Prop:Items}
  Brw1::CurrentScroll = 50
  DO Brw1::FillForward
  IF Brw1::ItemsToFill
    GET(Queue:Browse,1)
    RESET(CON:Key_Company,Brw1::Position)
    PREVIOUS(contacts)
    Brw1::CurrentScroll = 100
    DO Brw1::FillBackward
    IF Brw1::ItemsToFill
      Brw1::CurrentScroll = 0
    END
  END
  IF ~RECORDS(Queue:Browse)
    CLEAR(CON:Record)
    CLEAR(CON:Remarks)
    SET(CON:Key_Company)
    ?Change{Prop:Disable} = 1
    ?Delete{Prop:Disable} = 1
  ELSE
    DO Brw1::FillBuffer
    REGET(CON:Key_Company,Brw1::Position)
    ?Change{Prop:Disable} = 0
    ?Delete{Prop:Disable} = 0
  END
  SETCURSOR()
!----------------------------------------------------------------
Brw1::ButtonInsert ROUTINE
  GET(contacts,0)
  CLEAR(CON:Record,0)
  CLEAR(CON:Remarks)
  SET(CON:Key_Company)
  GlobalRequest = InsertRecord
  UpdateProc
  IF GlobalResponse = RequestCompleted
    DO Brw1::ValidateRecord
    IF Brw1::RecordStatus = Record:OK
      DO Brw1::LocateRecord
    END
  END
  ForceRefresh = True
  LocalRequest = OriginalRequest
!----------------------------------------------------------------
Brw1::ButtonChange ROUTINE
  GlobalRequest = ChangeRecord
  UpdateProc
  IF GlobalResponse = RequestCompleted
    DO Brw1::ValidateRecord
    IF Brw1::RecordStatus = Record:OK
      DO Brw1::LocateRecord
    ELSE
      SELECT(?List,CHOICE(?List))
    END
  END
  ForceRefresh = True
  LocalRequest = OriginalRequest
!----------------------------------------------------------------
Brw1::ButtonDelete ROUTINE
  GlobalRequest = DeleteRecord
  UpdateProc
  IF GlobalResponse = RequestCompleted
    DELETE(Queue:Browse)
    DO Brw1::RefreshPage
  END
  SELECT(?List,CHOICE(?List))
  ForceRefresh = True
  LocalRequest = OriginalRequest

ReportByCompany PROCEDURE
RejectRecord         LONG,AUTO
LocalRequest         LONG,AUTO
LocalResponse        LONG,AUTO
WindowOpened         LONG,AUTO
RecordsToProcess     LONG,AUTO
RecordsProcessed     LONG,AUTO
RecordsPerCycle      LONG,AUTO
RecordsThisCycle     LONG,AUTO
PercentProgress      DECIMAL(4,1)
RecordStatus         BYTE,AUTO
report               REPORT,AT(1000,2000,6000,7000),PRE(RPT),FONT('Arial',10,,),THOUS
                       HEADER,AT(1000,1000,6000,1000)
                         STRING('Contact Detail Sheet'),AT(1250,417,,),FONT('Arial',28,,FONT:bold+FONT:italic+FONT:underline),USE(?String16)
                       END
detail                 DETAIL
                         STRING(@s25),AT(0,0,,),USE(CON:Company)
                         STRING(@s20),AT(0,200,,),USE(CON:FirstName)
                         STRING(@s20),AT(0,400,,),USE(CON:LastName)
                         STRING(@s25),AT(0,600,,),USE(CON:Address1)
                         STRING(@s25),AT(0,800,,),USE(CON:Address2)
                         STRING(@s25),AT(0,1000,,),USE(CON:City)
                         STRING(@s2),AT(0,1200,,),USE(CON:State)
                         STRING(@s5),AT(0,1400,,),USE(CON:Zip)
                         STRING(@p(###) ###-####p),AT(0,1600,,),USE(CON:Phone)
                         STRING(@p(###) ###-####p),AT(0,1800,,),USE(CON:Fax)
                         STRING(@s25),AT(0,2000,,),USE(CON:JobTitle)
                         STRING(@s45),AT(0,2200,,),USE(CON:Interest)
                         STRING(@s15),AT(0,2400,,),USE(CON:TimeFrame)
                         STRING(@s25),AT(0,2600,,),USE(CON:CurrentSoftware)
                         STRING(@s45),AT(0,2800,,),USE(CON:Remarks)
                       END
                       FOOTER,AT(1000,9000,6000,1000)
                       END
                     END
ProgressWindow       WINDOW('Progress...'),AT(,,142,59),CENTER,TIMER(1),GRAY,DOUBLE
                       STRING(''),AT(0,3,141,10),USE(?Progress:UserString),CENTER
                       BOX,AT(15,15,111,12),COLOR(00H),FILL(0FFFFFFH)
                       BOX,AT(21,18,100,6),COLOR(00H),FILL(0C0C0C0H)
                       BOX,AT(21,18,100,6),USE(?Progress:Thermometer),FILL(0FFH)
                       STRING(''),AT(0,30,141,10),USE(?Progress:PctText),CENTER
                       BUTTON('Cancel'),AT(45,42,50,15),USE(?Progress:Cancel)
                     END
  CODE
  LocalRequest = GlobalRequest
  LocalResponse = RequestCancelled
  CLEAR(GlobalRequest)
  CLEAR(GlobalResponse)
  IF contacts::Used = 0
    CheckOpen(contacts,1)
  END
  contacts::Used += 1
  OPEN(ProgressWindow)
  RecordsToProcess = RECORDS(contacts)
  RecordsPerCycle = 25
  RecordsToProcess = RECORDS(contacts)
  RecordsPerCycle = 25
  RecordsProcessed = 0
  PercentProgress = 0
  ?Progress:Thermometer{Prop:Width} = 0
  ?Progress:PctText{Prop:Text} = '0.0% Completed'
    ProgressWindow{Prop:Text} = 'Printing Report'
  ?Progress:UserString{Prop:Text}=''
  ACCEPT
    CASE EVENT()
    OF Event:OpenWindow
      SET(CON:Key_Company)
      LOOP
        DO GetNextcontacts
        DO ValidateRecord
        EXECUTE RecordStatus
          BEGIN
            LocalResponse = RequestCancelled
            BREAK
          END
          CYCLE
        END
        BREAK
      END
      IF LocalResponse = RequestCancelled
        POST(Event:CloseWindow)
        CYCLE
      END
      OPEN(report)
    OF Event:Timer
      LOOP RecordsPerCycle TIMES
        PRINT(RPT:detail)
        LOOP
          DO GetNextRecord
          DO ValidateRecord
          EXECUTE RecordStatus
            BEGIN
              LocalResponse = RequestCancelled
              BREAK
            END
            CYCLE
          END
          BREAK
        END
        IF LocalResponse = RequestCancelled
          LocalResponse = RequestCompleted
          BREAK
        END
        LocalResponse = RequestCancelled
      END
      IF LocalResponse = RequestCompleted
        POST(Event:CloseWindow)
      END
    END
    CASE FIELD()
    OF ?Progress:Cancel
      CASE Event()
      OF Event:Accepted
        LocalResponse = RequestCancelled
        POST(Event:CloseWindow)
      END
    END
  END
  contacts::Used -= 1
  IF contacts::Used = 0 THEN CLOSE(contacts).
  IF LocalResponse
    GlobalResponse = LocalResponse
  ELSE
    GlobalResponse = RequestCancelled
  END
  RETURN
!-----------------------------------------------------------------------------
ValidateRecord       ROUTINE
  RecordStatus = Record:OutOfRange
  IF LocalResponse = RequestCancelled THEN EXIT.
  IF ERRORCODE() THEN EXIT.
  RecordStatus = Record:OK
  EXIT
GetNextcontacts ROUTINE
  LocalResponse = RequestCancelled
  LOOP
    NEXT(contacts)
    IF ERRORCODE() THEN EXIT.
    RecordsProcessed += 1
    RecordsThisCycle += 1
    IF PercentProgress < 100
      PercentProgress = (RecordsProcessed / RecordsToProcess)*100
      IF PercentProgress > 100
        PercentProgress = 100
      END
      ?Progress:Thermometer{Prop:Width} = ROUND(PercentProgress,0)
      ?Progress:PctText{Prop:Text} = FORMAT(PercentProgress,@N5.1) & '% Completed'
      DISPLAY()
    END
    BREAK
  END
  LocalResponse = RequestCompleted
  EXIT

GetNextRecord ROUTINE
  DO GetNextcontacts
  IF LocalResponse = RequestCompleted THEN EXIT.